home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Controls / Visual Basic Controls.iso / vbcontrol / vbgui10 / seek.frm < prev   
Text File  |  1998-01-26  |  10KB  |  283 lines
  1. VERSION 5.00
  2. Begin VB.Form WinSeek 
  3.    BackColor       =   &H00C0C0C0&
  4.    BorderStyle     =   3  'Fixed Dialog
  5.    Caption         =   "File Search "
  6.    ClientHeight    =   4905
  7.    ClientLeft      =   2685
  8.    ClientTop       =   1725
  9.    ClientWidth     =   4185
  10.    BeginProperty Font 
  11.       Name            =   "MS Sans Serif"
  12.       Size            =   8.25
  13.       Charset         =   0
  14.       Weight          =   700
  15.       Underline       =   0   'False
  16.       Italic          =   0   'False
  17.       Strikethrough   =   0   'False
  18.    EndProperty
  19.    ForeColor       =   &H00000080&
  20.    MaxButton       =   0   'False
  21.    MinButton       =   0   'False
  22.    ScaleHeight     =   4905
  23.    ScaleWidth      =   4185
  24.    Begin VB.PictureBox Picture2 
  25.       BorderStyle     =   0  'None
  26.       Height          =   3975
  27.       Left            =   4320
  28.       ScaleHeight     =   3975
  29.       ScaleWidth      =   2055
  30.       TabIndex        =   8
  31.       Top             =   0
  32.       Visible         =   0   'False
  33.       Width           =   2055
  34.       Begin VB.ListBox lstFoundFiles 
  35.          Height          =   3375
  36.          Left            =   -120
  37.          TabIndex        =   11
  38.          Top             =   480
  39.          Width           =   4335
  40.       End
  41.       Begin VB.Label lblCount 
  42.          Caption         =   "0"
  43.          Height          =   255
  44.          Left            =   3360
  45.          TabIndex        =   10
  46.          Top             =   120
  47.          Width           =   1575
  48.       End
  49.       Begin VB.Label lblfound 
  50.          Caption         =   "&Files Found:"
  51.          Height          =   255
  52.          Left            =   120
  53.          TabIndex        =   9
  54.          Top             =   120
  55.          Width           =   3135
  56.       End
  57.    End
  58.    Begin VB.PictureBox Picture1 
  59.       BorderStyle     =   0  'None
  60.       Height          =   4215
  61.       Left            =   120
  62.       ScaleHeight     =   4215
  63.       ScaleWidth      =   6855
  64.       TabIndex        =   2
  65.       Top             =   0
  66.       Width           =   6855
  67.       Begin VB.DriveListBox drvList 
  68.          Height          =   315
  69.          Left            =   2040
  70.          TabIndex        =   7
  71.          Top             =   60
  72.          Width           =   1935
  73.       End
  74.       Begin VB.DirListBox dirList 
  75.          Height          =   3465
  76.          Left            =   2040
  77.          TabIndex        =   6
  78.          Top             =   480
  79.          Width           =   1935
  80.       End
  81.       Begin VB.FileListBox filList 
  82.          Height          =   3600
  83.          Left            =   120
  84.          TabIndex        =   5
  85.          Top             =   480
  86.          Width           =   1815
  87.       End
  88.       Begin VB.TextBox txtSearchSpec 
  89.          Height          =   315
  90.          Left            =   120
  91.          TabIndex        =   4
  92.          Text            =   "*.*"
  93.          Top             =   60
  94.          Width           =   1815
  95.       End
  96.       Begin VB.Label lblCriteria 
  97.          Caption         =   "Search &Criteria:"
  98.          Height          =   255
  99.          Left            =   600
  100.          TabIndex        =   3
  101.          Top             =   120
  102.          Width           =   1335
  103.       End
  104.    End
  105.    Begin VB.CommandButton cmdSearch 
  106.       BackColor       =   &H00C0C0C0&
  107.       Caption         =   "&Search"
  108.       Default         =   -1  'True
  109.       Height          =   480
  110.       Left            =   480
  111.       TabIndex        =   0
  112.       Top             =   4320
  113.       Width           =   1200
  114.    End
  115.    Begin VB.CommandButton cmdExit 
  116.       BackColor       =   &H00C0C0C0&
  117.       Caption         =   "E&xit"
  118.       Height          =   480
  119.       Left            =   2520
  120.       TabIndex        =   1
  121.       Top             =   4320
  122.       Width           =   1200
  123.    End
  124. End
  125. Attribute VB_Name = "WinSeek"
  126. Attribute VB_GlobalNameSpace = False
  127. Attribute VB_Creatable = False
  128. Attribute VB_PredeclaredId = True
  129. Attribute VB_Exposed = False
  130. Option Explicit
  131. Dim SearchFlag As Integer   ' Used as flag for cancel and other operations.
  132. Private Sub cmdExit_Click()
  133.     If cmdExit.Caption = "E&xit" Then
  134.         Unload Me
  135.     Else                    ' If user chose Cancel, just end Search.
  136.         SearchFlag = False
  137.     End If
  138. End Sub
  139. Private Sub cmdSearch_Click()
  140. ' Initialize for search, then perform recursive search.
  141. Dim FirstPath As String, DirCount As Integer, NumFiles As Integer
  142. Dim result As Integer
  143.   ' Check what the user did last.
  144.     If cmdSearch.Caption = "&Reset" Then  ' If just a reset, initialize and exit.
  145.         ResetSearch
  146.         txtSearchSpec.SetFocus
  147.         Exit Sub
  148.     End If
  149.  
  150.     ' Update dirList.Path if it is different from the currently
  151.     ' selected directory, otherwise perform the search.
  152.     If dirList.Path <> dirList.List(dirList.ListIndex) Then
  153.         dirList.Path = dirList.List(dirList.ListIndex)
  154.         Exit Sub         ' Exit so user can take a look before searching.
  155.     End If
  156.  
  157.     ' Continue with the search.
  158.     Picture2.Move 0, 0
  159.     Picture1.Visible = False
  160.     Picture2.Visible = True
  161.  
  162.     cmdExit.Caption = "Cancel"
  163.  
  164.     filList.Pattern = txtSearchSpec.Text
  165.     FirstPath = dirList.Path
  166.     DirCount = dirList.ListCount
  167.  
  168.     ' Start recursive direcory search.
  169.     NumFiles = 0                       ' Reset found files indicator.
  170.     result = DirDiver(FirstPath, DirCount, "")
  171.     filList.Path = dirList.Path
  172.     cmdSearch.Caption = "&Reset"
  173.     cmdSearch.SetFocus
  174.     cmdExit.Caption = "E&xit"
  175. End Sub
  176. Private Function DirDiver(NewPath As String, DirCount As Integer, BackUp As String) As Integer
  177. '  Recursively search directories from NewPath down...
  178. '  NewPath is searched on this recursion.
  179. '  BackUp is origin of this recursion.
  180. '  DirCount is number of subdirectories in this directory.
  181. Static FirstErr As Integer
  182. Dim DirsToPeek As Integer, AbandonSearch As Integer, ind As Integer
  183. Dim OldPath As String, ThePath As String, entry As String
  184. Dim retval As Integer
  185.     SearchFlag = True           ' Set flag so the user can interrupt.
  186.     DirDiver = False            ' Set to True if there is an error.
  187.     retval = DoEvents()         ' Check for events (for instance, if the user chooses Cancel).
  188.     If SearchFlag = False Then
  189.         DirDiver = True
  190.         Exit Function
  191.     End If
  192.     On Local Error GoTo DirDriverHandler
  193.     DirsToPeek = dirList.ListCount                  ' How many directories below this?
  194.     Do While DirsToPeek > 0 And SearchFlag = True
  195.         OldPath = dirList.Path                      ' Save old path for next recursion.
  196.         dirList.Path = NewPath
  197.         If dirList.ListCount > 0 Then
  198.             ' Get to the node bottom.
  199.             dirList.Path = dirList.List(DirsToPeek - 1)
  200.             AbandonSearch = DirDiver((dirList.Path), DirCount%, OldPath)
  201.         End If
  202.         ' Go up one level in directories.
  203.         DirsToPeek = DirsToPeek - 1
  204.         If AbandonSearch = True Then Exit Function
  205.     Loop
  206.     ' Call function to enumerate files.
  207.     If filList.ListCount Then
  208.         If Len(dirList.Path) <= 3 Then             ' Check for 2 bytes/character
  209.             ThePath = dirList.Path                  ' If at root level, leave as is...
  210.         Else
  211.             ThePath = dirList.Path + "\"            ' Otherwise put "\" before the filename.
  212.         End If
  213.         For ind = 0 To filList.ListCount - 1        ' Add conforming files in this directory to the list box.
  214.             entry = ThePath + filList.List(ind)
  215.             lstFoundFiles.AddItem entry
  216.             lblCount.Caption = Str(Val(lblCount.Caption) + 1)
  217.         Next ind
  218.     End If
  219.     If BackUp <> "" Then        ' If there is a superior directory, move it.
  220.         dirList.Path = BackUp
  221.     End If
  222.     Exit Function
  223. DirDriverHandler:
  224.     If Err = 7 Then             ' If Out of Memory error occurs, assume the list box just got full.
  225.         DirDiver = True         ' Create Msg and set return value AbandonSearch.
  226.         MsgBox "You've filled the list box. Abandoning search..."
  227.         Exit Function           ' Note that the exit procedure resets Err to 0.
  228.